home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d17
/
sider.arc
/
SIDER.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-01-12
|
11KB
|
340 lines
{SIDER.PAS
Program to print ascii and .PRN files sideways on an Epson FX/LX-80 printer.
Provision is made for three type sizes and corresponding line spacing.
Bob MacDonald
Rt#1, Box 859
Lewisport, Ky 42351
(502)295-3120
Hope you find this program of some value. Any comments as to your modif-
ications or suggested enhancements are welcome.}
PROGRAM PRINT_TEXT_SIDEWAYS;
{$V-,C-}
TYPE
char_per_line = 0..240; { Maximum input line size }
vstr = array[0..240] of char;
rom_array = array[0..32000] of char;
Str24 = string[24];
CONST
size : char = 'L';
eofl = #26; { text EOF character = ^Z}
eol = #13; { cairrage return}
tab = #9;
lpp : integer = 85; { lines/page }
lpp1 : integer = 86; { lines/page + 1 }
lpi : integer = 3; { n/72th inch space between lines }
char_size : integer = 7; { dot size of characters }
view : boolean = false; {write to screen while printing?}
completed : boolean = false; {ready to exit to DOS?}
VAR answer : str24;
lptr : array[1..85] of ^vstr;
lptr2 : array[1..48] of ^vstr;
inbuf : array[char_per_line] of char;
linesize : char_per_line;
indx,line : 0..85;
indx2,line2: 0..48;
infile : file of char;
col : char_per_line;
pchar,i,
choice : integer;
ichar : 0..7; {8 bits per character}
max : char_per_line;
rom : ^rom_array;
inchar,ch : char;
ignore : set of #0..#$FF;
r : record case integer of
1 : (ax,bx,cx,dx,bp,si,di,ds,es,flags : integer);
2 : (al,ah,bl,bh,cl,ch,dl,dh : byte);
end;
{**************************************************************************}
{$I video.lib}
{$I scrn_hlp.lib}
{$I data_in.lib}
{$I ask.lib} {NOTE**** delete if using READLN to shorten listing}
{$I siderhlp.inc} {**NOTE** delete for no help screen}
{**************************************************************************}
procedure check_size;
begin
if (size = 'K') then
begin
line := line2;
indx := indx2;
end
else
begin
line := line;
indx := indx;
end;
end;
{**************************************************************************}
procedure print_char(pchar : integer);
begin
pchar := pchar * 8;
for ichar := 7 downto 0 do {Pickup character, a line at a time, }
write(lst,rom^[pchar+ichar]); {from ROM}
for ichar := 1 to lpi do
write(lst, #0);
end;
{**************************************************************************}
procedure print_it;
begin
if view then writeln('Line = ',line,' Max. = ',max);
if inchar <> eofl then
line := lpp
else
line := line -1;
if (size='Z') then size := 'L';
for col := 1 to max do
begin
write(lst,#27+'A'+chr(char_size)+#27+size, {send spacing & graph codes}
chr((line*(8+lpi)) mod 256), {to printer}
chr((line*(8+lpi)) div 256));
if (size <> 'K') then
begin
for indx := line downto 1 do
begin
if col > ord(lptr[indx]^[0]) then
pchar := ord(' ')
else
pchar := ord(lptr[indx]^[col]);
print_char(pchar);
if view then writeln;
end;
end
else
begin
for indx := line downto 1 do
begin
if col > ord(lptr2[indx]^[0]) then
pchar := ord(' ')
else
pchar := ord(lptr2[indx]^[col]);
print_char(pchar);
if view then writeln;
end;
end;
writeln(lst);
if view then writeln;
end;
writeln(lst);
if view then writeln;
if (size <> 'K') then
begin
for indx := 1 to line do dispose(lptr[indx]); {free up space on heap}
end
else
begin
for indx := 1 to line do dispose(lptr2[indx]);
end;
write(lst, #12); {form feed when completed}
end;
{**************************************************************************}
procedure read_file;
label break;
begin
if inchar = eol then {check for end-of-line}
begin
inbuf[0]:= chr(lo(linesize));
inbuf[1]:= chr(hi(linesize));
if (size <> 'K') then
begin
getmem(lptr[line],linesize+1); {allocate string storage }
move(inbuf[0],lptr[line]^,(linesize+1));{save }
end
else
begin
getmem(lptr2[line],linesize+1);
move(inbuf[0],lptr2[line]^,(linesize+1));
end;
if linesize > max then max := linesize;
linesize := 1;
line := line +1;
read(infile, inchar);
if view then writeln('<<');
goto break;
end;
if inchar = eofl then goto break;
if not(inchar in ignore) then
begin
if inchar = tab then
repeat
linesize := linesize+1;
inbuf[linesize] := ' ';
until (linesize mod 8) = 0
else
begin
linesize := linesize+1;
inbuf[linesize] := inchar;
end;
if view then write(inchar);
end;
read(infile, inchar);
break:
end;
{**************************************************************************}
procedure box_scrn;
begin
txt(3);
gotoxy(1,1);write(chr(201));
horzln(2,1,29,205);txt(15);write('[ SIDER Version 1.0]');
txt(3);
horzln(52,1,28,205);gotoxy(80,1);write(chr(187));
vertln(1,2,22,186);vertln(80,2,22,186);
gotoxy(3,3);write('With this program an input file can be printed');
write(' sideways on an EPSON LX80 or');
gotoxy(3,4);write('compatiable printer. This file can be in either');
write(' ASCII or PRN format');
gotoxy(3,5);txt(9);write('NOTE:');
txt(3);write(' the extended character set will not ');
write('print properly!');
gotoxy(1,6);write(chr(199));
horzln(2,6,78,196);
gotoxy(80,6);write(chr(182));
gotoxy(1,8);write(chr(199));
horzln(2,8,78,196);
gotoxy(80,8);write(chr(182));
gotoxy(55,8);write(chr(194));
vertln(55,9,14,179);
gotoxy(1,24);write(chr(200));
horzln(2,24,78,205);gotoxy(80,24);write(chr(188));
gotoxy(55,24);write(chr(207));
end;
{**************************************************************************}
procedure exit_prg; {clean-up prior to returning to DOS}
begin
std_cursor; {turn on normal cursor}
normvideo; {restore normal video}
clrscr;
completed := true; {everything normal so exit}
end;
{**************************************************************************}
procedure status;
begin
gotoxy(56,10);txt(9);write('Present Configuration');
gotoxy(56,11);txt(3);write('View = '); {erase previous setting}
gotoxy(76,11);write(' ');gotoxy(76,11);
if view then write(' On') else write('Off');
gotoxy(56,12);write('Char. Size = ');
case size of
'K' : write(' Normal');
'Z' : write(' Short');
'L' : write(' Small');
end;
gotoxy(56,13);write('Char/in. = ');
case size of
'K' : write(' 9');
'L' : write(' 12');
'Z' : write(' 9');
end;
gotoxy(56,14);write('Lines/in. = ');
case size of
'K' : write(' 6');
'L' : write(' 10');
'Z' : write(' 10');
end;
gotoxy(56,16);write('Max Lines Input = 240');
end;
{**************************************************************************}
procedure chng_size;
begin
gotoxy(4,9);txt(9);write(' Print Size Options ');
gotoxy(4,10);txt(3);write('Normal = 9 CPI/ 6 LPI');
gotoxy(4,11);write('Short = 9 CPI/ 10 LPI');
gotoxy(4,12);write('Small = 12 CPI/ 10 LPI');
choice := query(3,4,10,3,27,1);
case choice of
1 : begin
size := 'K';
lpi := 2;
char_size := 8;
if (lpp = 85) then lpp := 48;
if (lpp1 = 86) then lpp1 := 49;
end;
3 : begin
size := 'L';
lpi := 3;
char_size := 7;
if (lpp = 48) then lpp := 85;
if (lpp1 = 49) then lpp1 := 86;
end;
2 : begin
size := 'Z';
lpi := 3;
char_size := 9;
if (lpp = 48) then lpp := 85;
if (lpp1 = 49) then lpp1 := 86;
end;
end;
clr_area(4,9,30,13,5,7);
status;
end;
{**************************************************************************}
procedure do_it;
begin
check_size;
ignore:= [#0..#8,#10..#$1f,#$80..#$FF];
memw[seg(rom):ofs(rom)+2]:= $F000;
memw[seg(rom):ofs(rom)] := $FA6E;
std_cursor; {turn on cursor for data entry}
input('What file would you like to print SideWays :',3,7,24);
cursor(48,13); {turn off cursor again}
assign(infile,answer);
reset(infile);
read(infile, inchar);
if view then
begin
window(2,9,54,23);
clrscr;
end;
repeat
max := 0;
linesize := 1;
line := 1;
while (line <= lpp) and (inchar <> eofl) do
read_file;
print_it;
until inchar = eofl;
writeln(lst,chr(27),'@'); {RESET printer to defaults}
if view then clrscr;
window(1,1,80,25);
horzln(3,7,69,0);
end;
{*************************************************************************}
procedure main_menu;
begin
gotoxy(19,25);write(' View ');
gotoxy(29,25);write(' Size ');
gotoxy(40,25);write(' Print ');
gotoxy(48,25);write(' Quit ');
gotoxy(58,25);write(' Help '); {**NOTE** delete for no help screen}
choice := menu123(5,19,25,3,7); {<--the last '3' is the default option}
case choice of {change to suit your oun needs. }
1 : begin
if view then view := false else view := true; {toggle view}
status;
end;
2 : chng_size;
3 : do_it;
4 : exit_prg;
5 : siderhlp; {**NOTE** delete for no help screen}
end;
end;
{*************************************************************************}
begin
clrscr;
cursor(48,13); {turn cursor off}
box_scrn;
status;
while not completed do
begin
main_menu;
end;
end.